(* ======================================================================== *)
(** Circuit : module integrant. Module du circuit 
    @author Mathieu Barbin, Ocan Sankur
    @version samedi 17 novembre 2007 *)
(* ======================================================================== *)

(* ==================== *)
(*  Commentaires Impl.  *)
(* ==================== *)

(* 
   Chaque primitif registre est d'abord cree en tant que type Reg ou NReg, 
   qui sont des types auxiliaires.
   Reg ou NReg est en suite divise en deux: Regr et Regt. 
   Regr est le registre receiver, qui a comme valeur l'indice 
   de son conjuge Regt, ou Regt est le registre transmitter.
*)

(* ==================== *)
(*     Dependances      *)
(* ==================== *)
open Bplib
open Message
open ListMap
open Inputtools
(* ==================== *)

(* ===================================================================== *)
(** On depasse max int lors de la creation de fresh name
    (bravo a celui qui a ecrit la net_list) *)  
(* ===================================================================== *)
exception FreshOverflow 
(* ===================================================================== *)

(* ===================================================================== *)
(** Creer une fonction qui creer des freshs, a partir d'une fonction 
    de transformation des entiers *)  
(* ===================================================================== *)
let fresh_fct_factory transf =
  let index = ref 0 in
  let fresh_name () = 
    begin
      (
       if !index < max_int 
       then incr(index)
       else raise FreshOverflow 
      );
     transf (!index)
    end
  and fresh_init () = index := 0
  in (fresh_name,fresh_init)
(* ===================================================================== *)

(* ===================================================================== *)
(** Operations de transtypage des chaines vers les bool array *)  
(* ===================================================================== *)
let string_of_bits b = 
  let len = Array.length b in
  let s = String.make len '0' in
  for i = 0 to pred len do
    if b.(i) then s.[i] <- '1' else ()
  done;
  s
;;
exception Bits_of_string
let bits_of_string s = Array.init (String.length s) (fun i -> match s.[i] with | '1' -> true | '0' -> false | _ -> raise Bits_of_string)
(* ===================================================================== *)

(* Debug mode pour les ram : afficher l'etat de toutes les ram *)
(* mettre a false une fois le debug terminé *)
let affiche_ram = false;;

(* ======================================================================== *)
(** Array.fold_lefti : le fold avec l'index *)
(* ======================================================================== *)
let array_fold_lefti f init tab = 
  let len = Array.length tab in
  let rec aux accu index = 
    if index = len
    then accu
    else aux (f accu (Array.unsafe_get tab index) index) (succ index)
  in aux init 0
(* ======================================================================== *)

(* ======================================================================== *)
(** Transtypage classique des booleens vers les entiers *)
(* ======================================================================== *)
let int_of_bool = function
  | false -> 0
  | true -> 1
(* ======================================================================== *)

(* ======================================================================== *)
(** Etant donne un tableau binaire booleen, representant un nombre en binaire,
    on trouve sa representation decimale. Poids faibles a gauche bebop1.0 *)
(* ======================================================================== *)
let decimal_of_array t = 
  let len = Array.length t in 
  let dec = ref 0 in
  for i = pred len downto 0 do
    dec := 2 * !dec + (if t.(i) then 1 else 0)
  done;
  !dec
(* ======================================================================== *)

(* ======================================================================== *)
(** Attention, depuis bebop1.0, on lit les poids faibles à gauche.
    Il faudra donc reecrire visa avec cette nouvelle convention.
    Etant donne une partie d'un tableau binaire booleen, on trouve sa 
    representation decimale. (les poids forts a gauche)
    @param t le tableau
    @param offset l'indice ou on commence 
    @param long la longueur observee
    @return res10 la representation decimale de la partie lue.
    @raise Failure "decimal_of_partial_array" si la taille ne va pas  *)
(* ======================================================================== *)
let decimal_of_partial_array t offset long =  
  let len = Array.length t and index_fin = offset+long in 
  if index_fin > len
  then failwith "decimal_of_partial_array"
  else 
    let rec aux accu i = 
      if i < offset 
      then accu
      else aux (2 * accu + (int_of_bool (Array.unsafe_get t i))) (pred i)
    in aux 0 (pred index_fin) 
(* ======================================================================== *)

(* ======================================================================== *)
(** Type d'un co-processus pipe *)
(* ======================================================================== *)
type pipe_externe = {
	appel_p : string;
	sortiepipe : in_channel;
	entreepipe : out_channel
}
(* ======================================================================== *)

(* ======================================================================== *)
(** Primitifs noeuds.*)
(* ======================================================================== *)
type primitif =   Input | Output 
		  | Id (** l'identite (ca peut etre pratique) *)
		  | Not | Et | Ou | Xor | Mux
		  | Rom of string * int (* name + c'est l'indice du type de Rom *)
		  | Ram of string * (int * int * (bool array array)) 
		      (** name + arite entrante, sortante, et etat memoire courant *) 
		  | Reg | NReg 
		  | Regr of int | Regt 
		  | Clock | Gnd | Vdd 
		  | Opt (* adding v 1.1 *)
                  | PipeNode of (string * int * int ref) 
                      (** nom de la command unix, arite sortie minimale, et index dans la table des process *) 
                  | ExternalNode of (string * int * string * ((string ref) option) * string list * int * int ref)
                      (** fichier, ligne, bloc_name, method_name option, arguments string, arite_min, index dans la table des blocs externes *)    
(* ======================================================================== *)

(* ======================================================================== *)
(** type d'un noeud du circuit.
    entree,sortie : tableau des valeurs des entrees et des sorties du noeud
    voisins : chaque case correspond a une sortie.
    Pour chaque sorties il y a une liste de voisins branches a cette sorties.
    noeud_type : type du noeud

    le circuit cds est un tableau de tous ses noeuds. *) 
(* ======================================================================== *)
type noeud = {
	entree : bool array;
	sortie : bool array;
	voisins : ((int * int ) list) array; 
	(* indice_voisin, indice_composante *)
	noeud_type : primitif;
}

type cds = noeud array
(* ======================================================================== *)

(* ======================================================================== *)
(** Tri topologique du circuit. La fct cree un nouveau circuit et le recopie 
sur le cds donne en argument. 
 @param cds circuit 
 @return unit (effet de bord sur param cds)
 *)
(* ======================================================================== *)
let tri_topo cds = 
  let ncds = (Array.length cds) in
  (* order c'est le nouvel ordre des noeuds. order[0] est l'indice du premier noeud. order_inv c'est la bijection reciproque. *)
  let order = (Array.create ncds 0)
  and order_inv = (Array.create ncds 0 )
  and visited = (Array.create ncds false) in
  let no = ref (pred ncds) in
  (* parcour dfs pour calculer order et order_inv *)
  let rec dfs n = 
    let nv = (Array.length cds.(n).voisins) in
    visited.(n) <- true;
    for i = 0 to (pred nv) do
      List.iter (fun (m,_) -> if (not visited.(m)) then (dfs m) else ()) cds.(n).voisins.(i) 
    done;
    order.(!no) <- n;
    order_inv.(n) <- !no;
    decr(no)
  in
  (* a partir de order et order_inv met a jour les indices des voisins d'un noeud donne. 
     il recree le noeud et le retourne.  *)
  let update_voisins node = 
    for i = 0 to (pred (Array.length node.voisins)) do
      node.voisins.(i) <- List.map ( fun (n,c)-> (order_inv.(n),c) ) node.voisins.(i);
    done;
    match node.noeud_type with
	Regr(n) ->  {entree = node.entree; sortie = node.sortie; voisins = node.voisins; noeud_type = Regr( order_inv.(n)) };
	| _ -> node 
  in
  (* cree un nouveau cds  *)
  let reorder_cds () = 
	Array.init ncds (fun i -> update_voisins cds.(order.(i)) )
  in
  (* calcule les tableaux order et order_inv. On commence par 1 pour ne pas toucher au noeud input. *)
  message#tri_topo; 
  order.(0) <- 0;
  order_inv.(0) <- 0;
  for i = 1 to (pred ncds) do
    if (not visited.(i)) 
    then (dfs i)
    else ()
  done;
 let newcds = reorder_cds() in
 for i = 0 to (pred ncds) do
 	cds.(i) <- newcds.(i);
 done
(* ======================================================================== *)

(* ======================================================================== *)
(** Detecte les cycles. 
 @param cds circuit 
 @return true s'il y a un cycle. false sinon.*)
(* ======================================================================== *)
let detect_cycle cds = 
  let n = Array.length cds in
  let visited = Array.create n false 
  and parents = Array.create n false in
  let fun_ou a b = a || b in
  let rec iter_func = 
    fun (w,c) -> 
      if ( parents.(w) ) then true
      else 
	if ( not visited.(w) ) then (dfs w)
	else false
  and dfs v = 
    visited.(v) <- true;
    parents.(v) <- true;
    let retval = (Array.fold_left fun_ou false (Array.map (fun l -> List.fold_left fun_ou false (List.map iter_func l)) cds.(v).voisins)) in
    parents.(v) <- false;
    retval
  in
  Array.fold_left fun_ou false (Array.map (fun i -> if ( not visited.(i) ) then (dfs i) else false) (Array.init n (fun n->n)));;
(* ======================================================================== *)

(* ======================================================================== *)
(** split_registers. Divise chaque registre en deux: regr et regt. 
    Ainsi on elimine les cycles. 
    @param cds le circuit a traiter
    @return un nouveau cds acyclique *)
(* ======================================================================== *)
let split_registers cds = 
  let ncds = Array.length cds in
  let new_node_no = ref ncds in
  
  let rec count_registers i = 
    if ( i < Array.length cds) then begin
      match cds.(i).noeud_type with
	Reg -> 1 + (count_registers (succ i))
      | NReg -> 1+ (count_registers (succ i))
      | _ -> (count_registers (i+1))
    end else 0 
  in
  let new_ncds = (Array.length cds) + (count_registers 0) in
  let new_cds = Array.create new_ncds cds.(0) in
  (* en parcourant cds on cree les nouveaux registres transmitters 
     qu'on place au bout de new_cds *)
  for i = 0 to (pred ncds) do
    match cds.(i).noeud_type with
    | Reg ->  
	new_cds.(!new_node_no) <- { noeud_type = Regt; entree = [||]; sortie = [|false|];  voisins = cds.(i).voisins };
	cds.(i) <- { noeud_type = Regr(!new_node_no); entree = cds.(i).entree; sortie = [||]; voisins = [||] };
	incr(new_node_no);
    | NReg -> 
	new_cds.(!new_node_no) <- { noeud_type = Regt; entree = [||]; sortie = [|true|]; voisins = cds.(i).voisins };
	cds.(i) <- { noeud_type = Regr(!new_node_no); entree = cds.(i).entree; sortie = [||]; voisins = [||] };
	incr(new_node_no);
    | _ -> ()
  done;
  (* on recopie cds dans le nouveau tableau *) 
  for i = 0 to (pred ncds) do
    new_cds.(i) <- cds.(i);
  done;
  new_cds
(* ======================================================================== *)

(* ======================================================================== *)
(** La classe des objets de type circuit cds.
    L'objet permet d'obtenir une interface plus aisee avec la simulation *)
(* ======================================================================== *)
class circuit nom_circuit axiome cds_arg rom_memory_tab blocs_externes noms_entrees noms_sorties =
  let length_cds = Array.length cds_arg 
  and nombre_rom = Array.length rom_memory_tab in
object(this)
  val nom_du_circuit : string = nom_circuit
  val axiome : string = axiome
  val noms_entrees : string array = Array.of_list noms_entrees (* change dernierement *)
  val noms_sorties : string array = Array.of_list noms_sorties (* idem *)
  val cds = Array.copy cds_arg
  val ncds = length_cds
    (* Copie complete des rom_memory : FIXME *)
  val rom_memory = Array.init nombre_rom 
    (fun i -> 
       let lg_adresse = Array.length rom_memory_tab.(i) 
       and lg_mot = Array.length rom_memory_tab.(i).(0) in
       let tab = Array.create_matrix lg_adresse lg_mot false in
       begin
	 for j = 0 to pred lg_adresse do
	   for k = 0 to pred lg_mot do
	     tab.(j).(k) <- rom_memory_tab.(i).(j).(k)
	   done;
	 done;
	 tab
       end
    )

  val mutable externalprocess : pipe_externe array = [||] 
    
  (* determiner l'indice de l'unique noeud output *)
  val output_node =  
	  let rec find_output n = match cds_arg.(n).noeud_type with
		  | Output -> n
		  | _ -> if ( n < length_cds ) 
		    then find_output (succ n) 
		    else failwith "No Output node found in the cds" 
	  in find_output 0 

  val liste_index_registres = array_fold_lefti (fun accu noeud index -> (match noeud.noeud_type with Regr _ -> index::accu | _ -> accu)) [] cds_arg 

  method axiome = axiome

  method tableprocess = externalprocess

  (* ouvrir les co-process s'il y a lieu et allouer la table des process *)
  method init =
    let table_blocs_externes = ref StringMap.empty in
    let methodes_non_definies = ref StringSet.empty in
    let q = Queue.create () in
    let index = ref 0 in
    begin
      for i = 0 to pred ncds do
        match cds.(i).noeud_type with
          | PipeNode (command, arite_min, lien) ->
              begin
                message#init_process (!index) command arite_min;
                let (in_ch, out_ch) = Unix.open_process command in
                let new_pipe = 
                  {
                    appel_p = command;
                    sortiepipe = in_ch;
                    entreepipe = out_ch
                  } in
                Queue.add new_pipe q;
                lien := (!index);
                incr(index);
              end
          | ExternalNode (fichier, line, bloc_name, method_name, string_args, arite_min, lien) -> 
	      begin
		let decl_bloc = 
		  try List.assoc bloc_name blocs_externes
		  with Not_found -> Message.message#bloc_externe_indefini fichier line bloc_name; failwith "w-friendly" 
		in
		try
		  (* Ensuite, on remplace la methode par le vrai protocole *)
		  (
		    match (method_name) with
		    | None -> ()
		    | Some met ->
			(
			  try
			    let _, replace = List.assoc (!met) decl_bloc.methods in met := replace
			  with
			  | Not_found -> methodes_non_definies := StringSet.add (Printf.sprintf "%s.%s" bloc_name (!met)) (!methodes_non_definies)
			)
		  );
		  let bloc_index = StringMap.find bloc_name (!table_blocs_externes) in
		  lien := bloc_index
		with
		| Not_found -> 
		    begin
		      message#init_process (!index) decl_bloc.command_shell arite_min;
		      table_blocs_externes := StringMap.add bloc_name (!index) (!table_blocs_externes);
		      let (in_ch, out_ch) = Unix.open_process decl_bloc.command_shell in
		      let new_pipe = 
			{ 
			  appel_p = decl_bloc.command_shell;
			  sortiepipe = in_ch;
			  entreepipe = out_ch;
			} in
		      Queue.add new_pipe q;
		      lien := (!index);
		      incr(index);
		      (* On s'occupe des messages d'initialisation *)
		      List.iter (fun m -> 
				   try
				     Printf.fprintf new_pipe.entreepipe "%s\n" m;
				     flush new_pipe.entreepipe;
				     ignore (input_line new_pipe.sortiepipe);
				   with
				   | End_of_file -> message#pipe_error bloc_name (!lien) m; failwith "w-friendly"
				) decl_bloc.init_messages
		    end
	      end 
	  | _ -> ()
      done;
      List.iter (fun (a, b) -> if StringMap.mem a !table_blocs_externes then () else message#external_inutile message#get_net_list a) blocs_externes;
      StringSet.iter (fun m -> message#method_non_definie m) !methodes_non_definies;	      
      externalprocess <- Array.init (!index) (fun _ -> Queue.pop q);
      message#axiome axiome
    end

  method quit =
    for i = 0 to pred (Array.length externalprocess) do
      let process = externalprocess.(i) in
      try
        let stat = Unix.close_process (process.sortiepipe, process.entreepipe) in
        match stat with
          | Unix.WEXITED c -> message#close_process i process.appel_p "WEXITED" c
          | Unix.WSIGNALED c -> message#close_process_error i process.appel_p "WSIGNALED" c
          | Unix.WSTOPPED c -> message#close_process_error i process.appel_p "WSTOPPED" c      
      with
        | End_of_file -> message#close_process i process.appel_p "broken pipe" (-1)
        | e -> prerr_endline"Circuit#quit error"; raise e
    done

(* debug : *)
  method get_cds = cds

(* interface avec la simulation : *)
  method get_entree = cds.(0).sortie (* O c'est l'input *)
  method get_sortie = cds.(output_node).entree
  method get_nom_entrees = noms_entrees
  method get_nom_sorties = noms_sorties
  method get_name = nom_du_circuit

  method private get_output () = begin end

  method private propage n = 
    let nb_sorties = Array.length cds.(n).voisins in
    for i = 0 to (pred nb_sorties) do
      let valeur =  cds.(n).sortie.(i) in
      let fct_iter =  fun (m,c) -> cds.(m).entree.(c) <- valeur in
      List.iter fct_iter cds.(n).voisins.(i)
    done
      
(* la fct qui pour chaque regr met a jour le regt conjuge. a appeler a la fin d'un cycle.*)
  method private update_registers = 
    let f_iter i = 
      match cds.(i).noeud_type with 
	(* rappel de la convention: la entree.(1) d'un regr est toujours enable. *)
      | Regr n -> if ( cds.(i).entree.(1) ) then 
	  cds.(n).sortie.(0) <- cds.(i).entree.(0) 
	  else (); 
      | _ -> ()
    in List.iter f_iter liste_index_registres
	 
  (* fonctions de calcul de sorties pour les noeuds *)
  method private fct_id j =
    let cds_j = Array.unsafe_get cds j in
    let t = cds_j.entree 
    and s = cds_j.sortie in
    Array.unsafe_set s 0 (Array.unsafe_get t 0)

  method private fct_not j =
    let cds_j = Array.unsafe_get cds j in
    let t = cds_j.entree 
    and s = cds_j.sortie in
    Array.unsafe_set s 0 (not (Array.unsafe_get t 0))

  method private fct_et j =
    let cds_j = Array.unsafe_get cds j in
    let t = cds_j.entree 
    and s = cds_j.sortie in
    Array.unsafe_set s 0 (Array.unsafe_get t 0 && Array.unsafe_get t 1)

  method private fct_ou j =
    let cds_j = Array.unsafe_get cds j in
    let t = cds_j.entree 
    and s = cds_j.sortie in
    Array.unsafe_set s 0 (Array.unsafe_get t 0 || Array.unsafe_get t 1)

  method private fct_xor j =
    let cds_j = Array.unsafe_get cds j in
    let t = cds_j.entree 
    and s = cds_j.sortie in
    if not(Array.unsafe_get t 0)
    then Array.unsafe_set s 0 (Array.unsafe_get t 1)
    else Array.unsafe_set s 0 (not (Array.unsafe_get t 1))

  method private fct_mux j =
    let cds_j = Array.unsafe_get cds j in
    let t = cds_j.entree 
    and s = cds_j.sortie in
    if Array.unsafe_get t 0 
    then Array.unsafe_set s 0 (Array.unsafe_get t 1)
    else Array.unsafe_set s 0 (Array.unsafe_get t 2)

  method private fct_rom j n = 
    let cds_j = Array.unsafe_get cds j in
    (* reconstituer l'entree du noeud j en decimal *)
    let index = decimal_of_array cds_j.entree in
    let len_sortie = Array.length rom_memory.(n).(index) in
    (* copier dans la sortie, ce qu'il y a dans la rom n à la bonne adresse *)
    (* blit : source offset destination offset longueur *)
    Array.blit rom_memory.(n).(index) 0 cds_j.sortie 0 len_sortie

  (* dans le cas d'une ram, ca depend de la valeur de l'enable *)
  method private fct_ram j ar_e ar_s etat = 
    begin
      let cds_j = Array.unsafe_get cds j in
      let t = cds_j.entree 
      and s = cds_j.sortie in
      let enable = t.(2 * ar_e) in
      begin
	if affiche_ram 
	then 
	  begin
	    Printf.printf "Etat de la ram de la porte %d :\n" j;
	    for i = 0 to pred (Array.length etat) do
	      for j = 0 to pred ar_s do
		Printf.printf "%d" (int_of_bool etat.(i).(j));
	      done;
	      Printf.printf " ";
	    done;
	    Printf.printf "\n";
	    Printf.printf "Valeur de l'enable : %b\n" enable;
	    Printf.printf "Adresse de lecture : %d\n" (decimal_of_partial_array t 0 ar_e);
	    Printf.printf "Adresse d'ecriture : %d\n" (decimal_of_partial_array t ar_e ar_e);
	    Printf.printf "Mot d'entree : ";
	    for i = 0 to pred ar_s do
	      Printf.printf "%d" (int_of_bool t.(2*ar_e + 1 + i))
	    done;
	    Printf.printf "\n";
	  end
	else ();
	(
	match enable with
	| true ->
	    (* on doit modifier l'etat courant a la write adresse *)
	    (* on rappelle que la write adresse est la deuxieme donnee *)
	    let write_adresse = decimal_of_partial_array t ar_e ar_e in
	    (* on va chercher les data in qui sont en dernier *)
	    (* blit : source offset destination offset longueur *)
	    Array.blit t (2*ar_e + 1) (Array.unsafe_get etat write_adresse) 0 ar_s ;
	    (* proposition : dans ce cas, on rend aussi la valeur entree *)
	    (* Cette proposition est bien sympatique, mais fait planter le micro processeur visa *)
	    (* Array.blit t (2*ar_e + 1) s 0 ar_s *)
	    
	| false ->
	    (* on doit rendre le contenu de la memoire a la read adresse *)
	    let read_adresse = decimal_of_partial_array t 0 ar_e in
	    Array.blit (Array.unsafe_get etat read_adresse) 0 s 0 ar_s
	);
	if affiche_ram 
	then
	  begin
	    Printf.printf "Etat apres modification : \n";
	     for i = 0 to pred (Array.length etat)do
	      for j = 0 to pred ar_s do
		Printf.printf "%d" (int_of_bool etat.(i).(j));
	      done;
	      Printf.printf " ";
	    done;
	    Printf.printf "\n";
	    flush stdout;
	  end
	else ()
      end
    end

  (* la methode fct_external et fct_pipe sont presque identique pour les PipeNode et les ExternalNode *)
  method private fct_external j =
    let cds_j = Array.unsafe_get cds j in
    let t = cds_j.entree 
    and s = cds_j.sortie in
    match cds_j.noeud_type with
      | PipeNode (command, arite_min, index) ->
          (
            let protocole_entree = string_of_bits t in
            try
              let pipe_ex = externalprocess.(!index) in
              begin
                (* On demande le calcul au process extern selon le protocole pipe01 *)
		(* if Array.length t > 0 (* FIXME *)
		then *)
		(* Sous linux, l'ajout du \r ne poserait peut etre pas probleme puisqu'on laisse depasser le protocole *)
		(
		  try
                    Printf.fprintf pipe_ex.entreepipe "%s\n" protocole_entree;
                    flush pipe_ex.entreepipe; (* ne pas l'oublier sinon ca marche pas ! *)
		  with
		    _ -> (message#pipe_error command (!index) protocole_entree; failwith "w-friendly")
		);
		(* else (); *)
                (* la simulation est en attente le temps que le process met a repondre *)
		(* FIXME *)
		if arite_min > 0
		then
		  begin
                    let reponse = (* if arite_min = 0 then ""  else *) Bplib.safe_input_line pipe_ex.sortiepipe in
                    let len_sortie = String.length reponse in
                    let protocole_sortie = 
                      try 
			bits_of_string reponse
                      with
                      | Bits_of_string -> (message#protocole_sortie_error command (!index) protocole_entree reponse; failwith "w-friendly") 
                    in 
                    if len_sortie < arite_min
                    then
                      (message#pipe_arite_sortie_error command (!index) protocole_entree reponse arite_min len_sortie; failwith "w-friendly")
                    else
                      begin
			(* on applique le resultat du calcul du processus *)
			Array.blit protocole_sortie 0 s 0 (Array.length s)
                      end
		  end
		else ignore (input_line pipe_ex.sortiepipe)
              end 
            with
              | End_of_file -> (message#pipe_error command (!index) protocole_entree; failwith "w-friendly")
          )
      | ExternalNode (_, _, bloc_name, method_name, string_args, arite_min, index) ->
          (
            let protocole_entree = string_of_bits t in
            try
              let pipe_ex = externalprocess.(!index) in
              begin
                (* On demande le calcul au process extern selon le protocole pipe01 *)
		(* Sous linux, l'ajout du \r ne poserait peut etre pas probleme puisqu'on laisse depasser le protocole *)
                let protocole_complet =
		  match method_name, string_args with
		  | None, [] -> protocole_entree
		  | None, o -> Printf.sprintf "%s %s" (Bplib.string_of_string_list o) protocole_entree (* FIXME : string_of_string list est constant *)
		  | Some met, [] -> Printf.sprintf "%s %s" !met protocole_entree
		  | Some met, o -> Printf.sprintf "%s %s %s" !met (Bplib.string_of_string_list o) protocole_entree
		in
		Printf.fprintf pipe_ex.entreepipe "%s\n" protocole_complet;
                flush pipe_ex.entreepipe; (* ne pas l'oublier sinon ca marche pas ! *)
	        (* la simulation est en attente le temps que le process met a repondre *)
		(* FIXME *)
		if arite_min > 0
		then
		  begin
                    let reponse = (* if arite_min = 0 then "" else *) Bplib.safe_input_line pipe_ex.sortiepipe in
                    let len_sortie = String.length reponse in
                    let protocole_sortie = 
                      try 
			bits_of_string reponse
                      with
                      | Bits_of_string -> (message#protocole_sortie_error bloc_name (!index) protocole_complet reponse; failwith "w-friendly") 
                    in 
                    if len_sortie < arite_min
                    then
                      (message#pipe_arite_sortie_error bloc_name (!index) protocole_complet reponse arite_min len_sortie; failwith "w-friendly")
                    else
                      begin
			(* on applique le resultat du calcul du processus *)
			Array.blit protocole_sortie 0 s 0 (Array.length s)
                      end
		  end 
		else ignore (input_line pipe_ex.sortiepipe) 
	      end
            with
              | End_of_file -> (message#pipe_error bloc_name (!index) protocole_entree; failwith "w-friendly")
          )
      | _ -> ()

          

  (* Main Cycle*)
  method un_cycle valeurs_entrees = begin
    for j = 0 to (pred ncds) do
      (
      match (Array.unsafe_get cds j).noeud_type with
	Input -> valeurs_entrees (Array.unsafe_get cds j).sortie 
      | Output -> () 
      | Id -> this#fct_id j
      | Not -> this#fct_not j
      | Et -> this#fct_et j
      | Ou -> this#fct_ou j
      | Xor-> this#fct_xor j
      | Mux -> this#fct_mux j
      | Rom (_, n) -> this#fct_rom j n
      | Ram (_, (ar_e, ar_s, etat_courant))  -> this#fct_ram j ar_e ar_s etat_courant
      | Clock -> () (* initialisee a true a la creation du circuit *)
      | Gnd -> ()   (* initialisee a false *)
      | Vdd -> ()   (* init a false *)
      | PipeNode _ -> this#fct_external j
      | ExternalNode _ -> this#fct_external j
      | Opt -> () (* failwith "Remove opt incomplet after optimisation" *)
      | Reg | NReg | Regr _ | Regt -> ()
          (* cf update registers pour le reste *)
      );
      this#propage j;
    done;
    this#update_registers;
  end

  method print_output = 
	Printf.printf "Output contains: \n";
	Array.iter (fun n->begin if (n) then print_int 1 else print_int 0 end) 
	  cds.(output_node).entree;
	print_newline()
end
(* ======================================================================== *)
